home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATHLIB2 / HYPERBOL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-14  |  4KB  |  131 lines
  1. Unit HYPERBOL;
  2.  
  3. (* Bibliotheque mathematique des fonctions hyperboliques *)
  4. (* JD GAYRARD mars 94 *)
  5.  
  6. (* revision 1.0 de Oct 95 pour :
  7. - correction de arg_th (test valeur negative) *)
  8.  
  9. {$G+}
  10. {$N+}
  11. {$E-}
  12.  
  13. interface
  14.  
  15. uses MATHLIB;
  16.  
  17. const author  = 'GAYRARD J-D';
  18.       version = 'ver 1.0 - 10/95';
  19.  
  20. const TANH_MAX = 13;       (* argument maximum de th(x) pour type real *)
  21.       SQR_MAX = 1.3E+19;   (* argument maximum d'un carre pour type real *)
  22.       EXP_MAX = 88.0288;   (* argument maximum de exp pour type real *)
  23.  
  24. (* fonctions trigonometriques directes *)
  25. function ch(x : float): float;
  26. function sh(x : float): float;
  27. function th(x : float): float;
  28.  
  29. (* fonctions trigonometriques inverses *)
  30. function arg_ch(x : float): float;
  31. function arg_sh(x : float): float;
  32. function arg_th(x : float): float;
  33.  
  34. implementation
  35.  
  36. (* fonctions trigonometriques directes *)
  37.  
  38. function ch(x : float): float;
  39. (* retourne le cosinus hyperbolique de l'argument *)
  40. (* ch(x) = [exp(x) + exp(-x)] / 2 *)
  41. begin
  42. if (x > EXP_MAX) or (x < - EXP_MAX)
  43.    then begin
  44.         writeln('******** Fonction ch ********');
  45.         writeln('********* OVERFLOW **********');
  46.         halt
  47.         end
  48.    else begin
  49.         x := exp(x);
  50.         ch := 0.5 * (x + 1.0 / x)
  51.         end
  52. end;
  53.  
  54. function sh(x : float): float;
  55. (* retourne le sinus hyperbolique de l'argument *)
  56. (* sh(x) = [exp(x) - exp(-x)] / 2 *)
  57. begin
  58. if (x > EXP_MAX) or (x < -EXP_MAX)
  59.    then begin
  60.         writeln('******** Fonction sh ********');
  61.         writeln('********* UNDERFLOW *********');
  62.         halt
  63.         end
  64.    else begin
  65.         x := exp(x);
  66.         sh := 0.5 * (x - (1.0 / x))
  67.         end
  68. end;
  69.  
  70. function th(x : float): float;
  71. (* retourne la tangente hyperbolique de l'argument *)
  72. (* th(x) = sh(x) / ch(x) *)
  73. (* th(x) = [exp(x) - exp(x)] / [exp(x) + exp(-x)] *)
  74. begin
  75. if (x > TANH_MAX) or (x < - TANH_MAX)
  76.    then if x > 0.0 then th := 1.0
  77.                    else th := - 1.0
  78.    else th := sh(x) / ch(x)
  79. end;
  80.  
  81. (* fonctions trigonometriques inverses *)
  82.  
  83. function arg_ch(x : float): float;
  84. (* retourne l'arc cosinus hyperbolique de l'argument *)
  85. (*                       ________          *)
  86. (* arg ch(x) = ln ( x + V x.x - 1 )  fonction definie pour x >=1 *)
  87. begin
  88. if x < 1.0
  89.    then begin
  90.         writeln('******** Fonction arg_ch ********');
  91.         writeln('********** RANGE ERROR **********');
  92.         halt
  93.         end
  94.    else if x > SQR_MAX
  95.            then begin
  96.                 writeln('******** Fonction  arg_ch ********');
  97.                 writeln('************ OVERFLOW ************');
  98.                 halt
  99.                 end
  100.            else arg_ch := ln(x + sqrt(x * x - 1.0))
  101. end;
  102.  
  103. function arg_sh(x : float): float;
  104. (* retourne l'arc sinus hyperbolique de l'argument *)
  105. (*                       _________   *)
  106. (* arg sh(x) = ln ( x + V x.x + 1 )  *)
  107. begin
  108. if (x < -SQR_MAX) or (x > SQR_MAX)
  109.    then begin
  110.         writeln('******** Fonction Arg_sh ********');
  111.         writeln('************ OVERFLOW ***********');
  112.         halt
  113.         end
  114.    else arg_sh := ln(x + sqrt(x * x + 1.0))
  115. end;
  116.  
  117. function arg_th(x : float): float;
  118. (* retourne l'arc tangente hyperbolique de l'argument *)
  119. (* arg th(x) = 1/2 ln [ (1 + x) / (1 - x) fonction definie pour |x| < 1 *)
  120. begin
  121. if (x <= -1.0) or (x >= 1.0)
  122.    then begin
  123.         writeln('******** Fonction Arg_th ********');
  124.         writeln('********** RANGE ERROR **********');
  125.         halt
  126.         end
  127.    else arg_th := signe(0.5 * ln((1.0 + x) / (1.0 - x)),x)
  128.  
  129. end;
  130.  
  131. end.